home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / STORUTIL.D < prev    next >
Encoding:
Modula Definition  |  1994-06-03  |  5.6 KB  |  160 lines
  1. DEFINITION MODULE StorUtils;
  2. (*------------------------------------------------------------------------*)
  3. (* Debuggingroutien mit Hilfe von Storage                                 *)
  4. (* Erstellt unter Verwendung von NewStorTest                              *)
  5. (* Kann nur für Megamax Modula-2 verwendet werden                         *)
  6. (*------------------------------------------------------------------------*)
  7. (* Autor:                                                                 *)
  8. (* Gerd Castan, Hoehbergstr. 16, 70327 Stuttgart                          *)
  9. (* EMail: G.Castan@physik.uni-stuttgart.de                                *)
  10. (*------------------------------------------------------------------------*)
  11. (* Version | Datum    | Arbeitsbericht                                    *)
  12. (* 1       | 26.03.94 | Addr/Block/BlockExactInStorage                    *)
  13. (* 2       | 26.03.94 | GetAllocInfo,TestStorage                          *)
  14. (*------------------------------------------------------------------------*)
  15.  
  16. FROM SYSTEM IMPORT ADDRESS;
  17.  
  18.  
  19. PROCEDURE GetAllocInfo (addr: ADDRESS; VAR start: ADDRESS; VAR size: LONGCARD);
  20.   (* Wenn addr zu einem Speicherblock gehört, der mit Storage.ALLOCATE
  21.    * angefordert wurde, gibt start den Beginn und size die Länge dieses
  22.    * Speicherblocks an, sonst ist start=NIL und size=0.
  23.    *)
  24.  
  25. PROCEDURE AddrInStorage (addr: ADDRESS): BOOLEAN;
  26.   (* Gehört addr zu einem Speicherblock, der mit Storage.ALLOCATE angefordert
  27.    * wurde?
  28.    *)
  29.  
  30. PROCEDURE BlockInStorage (addr: ADDRESS; size: LONGCARD): BOOLEAN;
  31.   (* Paßt addr in einen Speicherblock, der mit Storage.ALLOCATE angefordert
  32.    * wurde?
  33.    *)
  34.  
  35. PROCEDURE BlockExactInStorage (addr: ADDRESS; size: LONGCARD): BOOLEAN;
  36.   (* Paßt addr exakt in einen Speicherblock, der mit Storage.ALLOCATE
  37.    * angefordert wurde?
  38.    *)
  39.  
  40. TYPE
  41.   StorageError = (
  42.     storageOK,
  43.     storageInconsistent,  (* StorBase.Inconsistent *)
  44.     storageNIL,           (* NIL in der Block-Verkettung *)
  45.     storageOdd,           (* Blockverkettung mit ungerader Adresse *)
  46.     storageNotAlloc,      (* Block nicht über StorBase geholt *)
  47.     storageCircle1,       (* Blockverkettung endet nicht bei RootPtr *)
  48.     storagePrev1,         (* Rückwärtsverkettung von Block defekt *)
  49.     storagePrev2,         (* Rückwärtsverkettung der Granulierung defekt *)
  50.     storageNext2,         (* Vorwärtsverkettung der Granulierung defekt *)
  51.     storageSize2          (* Granulierte Daten ragen in den nächsten Bereich *)
  52.   );
  53.  
  54. PROCEDURE TestStorage (): StorageError;
  55.   (* Unterzieht die interne Speicherverwaltung von Storage einem
  56.    * Plausibilitätstest.
  57.    * Wird storageOk zurückgegeben, ist (wahrscheinlich) alles in Ordnung.
  58.    *
  59.    * Wenn nicht, gibt es dafür 2 mögliche Ursachen:
  60.    * - Ein Fehler in Storage.
  61.    *   In diesem Fall geben die Fehlermeldungen an, wo der Fehler zu suchen ist.
  62.    * - Wahrscheinlicher: Ihr Programm oder ein parallel laufendes Programm
  63.    *   hat wild in den Speicher geschrieben.
  64.    *   In diesem Fall zählt nur, ob storageOk oder etwas anderes
  65.    *   zurückgegeben wurde.
  66.    *   Welcher Fehler zurückgegeben wird ist hier uninteressant.
  67.    *)
  68.  
  69. END StorUtils.
  70.  
  71.  
  72. (* Und hier auch gleich ein Demo/Testprogramm dazu:
  73.  
  74. MODULE StorTest;
  75.  
  76. FROM SYSTEM IMPORT ADDRESS;
  77.  
  78. FROM InOut IMPORT
  79.   WriteString, WriteLn, Read;
  80. FROM StorUtils IMPORT
  81.   StorageError, TestStorage, BlockExactInStorage, GetAllocInfo;
  82. FROM Storage IMPORT
  83.   ALLOCATE, DEALLOCATE;
  84. FROM StrConv IMPORT
  85.   LHexToStr;
  86.  
  87. TYPE
  88.   HugeString = ARRAY [0..MAX(LONGINT)] OF CHAR;
  89.   PtrHugeString = POINTER TO HugeString;
  90.  
  91. PROCEDURE
  92.   WriteBlock (progStart,storStart: ADDRESS; progSize, storSize: LONGCARD);
  93.  
  94. BEGIN
  95.   WriteString ('progStart: '); WriteString (LHexToStr (progStart,7)); WriteLn;
  96.   WriteString ('storStart: '); WriteString (LHexToStr (storStart,7)); WriteLn;
  97.   WriteString ('progSize: '); WriteString (LHexToStr (progSize,7)); WriteLn;
  98.   WriteString ('storSize: '); WriteString (LHexToStr (storSize,7)); WriteLn;
  99. END WriteBlock;
  100.  
  101.  
  102. VAR
  103.   err: StorageError;
  104.   CH : CHAR;
  105.   ptrHugeString: PtrHugeString;
  106.   start: ADDRESS;
  107.   size : LONGCARD;
  108.   I    : LONGCARD;
  109.  
  110. CONST
  111.   initSize = 100000;  (* verhindert Granulierung *)
  112.   diffSize  = 10000;
  113. BEGIN
  114.   WriteString ('Starte TestStorage...'); WriteLn;
  115.  
  116.   err := TestStorage();
  117.   CASE err
  118.   OF storageOK           : WriteString ('OK');
  119.   |  storageInconsistent : WriteString ('Inconsistent');
  120.   |  storageNIL          : WriteString ('NIL');
  121.   |  storageNotAlloc     : WriteString ('NotAlloc');
  122.   |  storageCircle1      : WriteString ('Circle1');
  123.   |  storagePrev1        : WriteString ('Prev1');
  124.   |  storagePrev2        : WriteString ('Prev2');
  125.   |  storageNext2        : WriteString ('Next2');
  126.   |  storageSize2        : WriteString ('Size2');
  127.   ELSE                     WriteString ('Unbekannter Fehler');
  128.   END;
  129.   WriteLn();
  130.  
  131.   WriteString ('Taste...');
  132.   Read (CH);
  133.   WriteLn();
  134.  
  135.   (* Für kleine Blöcke ist der folgende Test schon durch ein 'richtiges'
  136.    * Programm durchgeführt
  137.    *)
  138.   ALLOCATE (ptrHugeString, initSize);
  139.   IF ~BlockExactInStorage (ptrHugeString, initSize) THEN
  140.     GetAllocInfo (ptrHugeString, start, size);
  141.     WriteBlock (ptrHugeString, start, initSize, size);
  142.   END;
  143.  
  144.   (* Daß beim letzten Durchgang alles deallociert ist, ist beabsichtigt. *)
  145.   FOR I := 1 TO 10 DO
  146.     DEALLOCATE (ptrHugeString, diffSize);
  147.     IF ~BlockExactInStorage (ptrHugeString, initSize-I*diffSize) THEN
  148.       GetAllocInfo (ptrHugeString, start, size);
  149.       WriteBlock (ptrHugeString, start, initSize-I*diffSize, size);
  150.     END;
  151.   END;
  152.  
  153.   WriteString ('Taste...');
  154.   Read (CH);
  155.   WriteLn();
  156.  
  157. END StorTest.
  158.  
  159. *)
  160.